home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume23 / lome / part02 < prev    next >
Encoding:
Internet Message Format  |  1991-01-08  |  55.1 KB
  1. Path: j.cc.purdue.edu!mentor.cc.purdue.edu!noose.ecn.purdue.edu!samsung!zaphod.mps.ohio-state.edu!wuarchive!uunet!papaya.bbn.com!rsalz
  2. From: rsalz@bbn.com (Rich Salz)
  3. Newsgroups: comp.sources.unix
  4. Subject: v23i052:  Line oriented macro processor, Part02/09
  5. Message-ID: <3026@litchi.bbn.com>
  6. Date: 29 Nov 90 17:41:15 GMT
  7. Organization: BBN Systems and Technologies, Cambridge MA
  8. Lines: 2077
  9. Approved: rsalz@uunet.UU.NET
  10.  
  11. Submitted-by: Darren New <new@ee.udel.edu>
  12. Posting-number: Volume 23, Issue 52
  13. Archive-name: lome/part02
  14.  
  15.  
  16. #! /bin/sh
  17. # This is a shell archive.  Remove anything before this line, then unpack
  18. # it by saving it into a file and typing "sh file".  To overwrite existing
  19. # files, type "sh file -c".  You can also feed this as standard input via
  20. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  21. # will see the following message at the end:
  22. #        "End of archive 2 (of 9)."
  23. # Contents:  LOME/Ifuncs1.c LOME/Ifuncs2.c LOME/Ifuncs3.c
  24. #   LOME/Ifuncs4.c LOME/LOME.c LOME/LOME2.c LOME/LOME7.c
  25. #   LOME/MacroIO.c LOME/MakeTail LOME/Rubin.out LOME/SCMTestD.inp
  26. #   PPL/FaultAmiga.c PPL/FaultUnix.c TFS/TFS.doc TFS/TestTFS.inp
  27. #   TFS/TestTFS2.out
  28. # Wrapped by new@estelle.ee.udel.edu on Tue Aug 14 16:09:55 1990
  29. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  30. if test -f 'LOME/Ifuncs1.c' -a "${1}" != "-c" ; then 
  31.   echo shar: Will not clobber existing file \"'LOME/Ifuncs1.c'\"
  32. else
  33. echo shar: Extracting \"'LOME/Ifuncs1.c'\" \(3692 characters\)
  34. sed "s/^X//" >'LOME/Ifuncs1.c' <<'END_OF_FILE'
  35. X/*
  36. X * Ifuncs1.c
  37. X * SCM Interpreter Function set One
  38. X * Copyright 1988 Darren New.
  39. X * All rights reserved.
  40. X */
  41. X
  42. X#include "PPL.h"
  43. X#include "MacroIO.h"
  44. X
  45. X#include "Interp.h"
  46. X
  47. Xint Ebp(c)          /* BEGIN PROGRAM */
  48. X    int c;
  49. X{
  50. X    PLStatus(0, "YCGTFH Fbp");
  51. X    return -1;
  52. X    }
  53. X
  54. Xint Ibp(c)
  55. X    int c;
  56. X{
  57. X    if (c != 0) PLStatus(0, "BEGIN PROGRAM must be first");
  58. X    return -1;
  59. X    }
  60. X
  61. Xint Eep(c)          /* END PROGRAM */
  62. X    int c;
  63. X{
  64. X    PLStatus(0, "YCGTFH Fep");
  65. X    return -1;
  66. X    }
  67. X
  68. Xint Iep(c)
  69. X    int c;
  70. X{
  71. X    return -1;
  72. X    }
  73. X
  74. X#ifdef DEBUGF_DEFINED
  75. Xstatic void calldebug(void);
  76. Xstatic void calldebug() { Edebug(0); }
  77. X#endif
  78. X
  79. Xint Ebmr(c)         /* BEGIN MAIN ROUTINE */
  80. X    int c;
  81. X{
  82. X    register short i;
  83. X
  84. X#ifdef DEBUGF_DEFINED
  85. X    void calldebug(void);
  86. X    DEBUG_FUNC[0] = calldebug;
  87. X#endif
  88. X
  89. X    /* the next is -1, +1 because Iparse uses the first name as a source */
  90. X    MStartIO(PLargcnt - 1, PLarglist + 1);
  91. X
  92. X    for (i = '0'; i < '4'; i++)
  93. X    f[i] = PLToInt(i);
  94. X    for (i = '0'; i <= '9'; i++)
  95. X    v[i] = PLToInt(i);
  96. X    for (i = '0'; i < '6'; i++)
  97. X    p[i] = PLToInt(i);
  98. X    p['6'] = 10;
  99. X    p['8'] = 0; /* MINMEM */
  100. X    p['9'] = MAXMEM;
  101. X
  102. X    /* DEBUGF(7, "line %3d: BEGIN MAIN ROUTINE" C c); */
  103. X
  104. X    return c+1;
  105. X    }
  106. X
  107. Xint Ibmr(c)
  108. X    int c;
  109. X{
  110. X    startLine = c;
  111. X    /* DEBUGF(9, "Execution will begin at line %d" C c); */
  112. X    return -1;
  113. X    }
  114. X
  115. Xint Eemr(c)         /* END MAIN ROUTINE */
  116. X    int c;
  117. X{
  118. X    /* DEBUGF(7, "line %3d: END MAIN ROUTINE" C c); */
  119. X    MStopIO();
  120. X    return -1;
  121. X    }
  122. X
  123. Xint Iemr(c)
  124. X    int c;
  125. X{
  126. X    return -1;
  127. X    }
  128. X
  129. Xint Ebs(c)          /* BEGIN SUBROUTINE $ */
  130. X    int c;
  131. X{
  132. X    /* DEBUGF(7, "line %3d: BEGIN SUBROUTINE %c" C c C param[0]); */
  133. X    return c+1;
  134. X    }
  135. X
  136. Xint Ibs(c)
  137. X    int c;
  138. X{
  139. X    if (subr[param[0]] != 0)
  140. X    PLStatus(0, "Subroutine begun twice");
  141. X    else
  142. X    subr[param[0]] = c;
  143. X    /* DEBUGF(9, "Subroutine %c starts at line %d" C param[0] C c); */
  144. X    return -1;
  145. X    }
  146. X
  147. Xint Ees(c)          /* END SUBROUTINE $ */
  148. X    int c;
  149. X{
  150. X    /* DEBUGF(7, "line %3d: END SUBROUTINE %c" C c C param[0]); */
  151. X    return (int) p[param[0]];
  152. X    }
  153. X
  154. Xint Ies(c)
  155. X    int c;
  156. X{
  157. X    if (subr[param[0]] == 0)
  158. X    PLStatus(0, "Subroutine not yet begun");
  159. X    return -1;
  160. X    }
  161. X
  162. Xint El(c)           /* LABEL $$ */
  163. X    int c;
  164. X{
  165. X    /* DEBUGF(7, "line %3d: LABEL %c%c" C c C param[0] C param[1]); */
  166. X    return c+1;
  167. X    }
  168. X
  169. Xint Il(c)
  170. X    int c;
  171. X{
  172. X    register short i = PLToInt(param[0]) * 10 + PLToInt(param[1]);
  173. X    if (i < 1 || i > 99) {
  174. X    PLStatus(0, "Bad label");
  175. X    return -1;
  176. X    }
  177. X    if (labl[i]) PLStatus(0, "Label defined twice");
  178. X    labl[i] = c;
  179. X    /* DEBUGF(9, "Label %d is at line %d" C i C c); */
  180. X    return -1;
  181. X    }
  182. X
  183. Xint Ecd(c)          /* CHRDATA $$ $ $ $$ */
  184. X    int c;
  185. X{
  186. X    short i = PLToInt(param[0]) * 10 + PLToInt(param[1]);
  187. X    unsigned p = PLToInt(param[4]) * 10 + PLToInt(param[5]);
  188. X    unsigned f = PLToInt(param[2]);
  189. X    unsigned v = param[3];
  190. X
  191. X    if (i < 0 || i > 99 || p > 99) {
  192. X    PLStatus(0, "Bad CHRDATA number");
  193. X    return -1;
  194. X    }
  195. X
  196. X    mem[i] = (v << 24) | ((f & 3) << 22) | (p & 0x3FFFFF);
  197. X    /* DEBUGF(8, "line %3d: CHRDATA" C c); */
  198. X    return c + 1;
  199. X    }
  200. X
  201. Xint Icd(c)
  202. X    int c;
  203. X{
  204. X    return -1;
  205. X    }
  206. X
  207. Xint End(c)          /* NUMDATA $$ $ $$ $$ */
  208. X    int c;
  209. X{
  210. X    short i = PLToInt(param[0]) * 10 + PLToInt(param[1]);
  211. X    unsigned v = PLToInt(param[3]) * 10 + PLToInt(param[4]);
  212. X    unsigned p = PLToInt(param[5]) * 10 + PLToInt(param[6]);
  213. X    unsigned f = PLToInt(param[2]);
  214. X
  215. X    if (i < 0 || i > 99 || p > 99 || v > 99) {
  216. X    PLStatus(0, "Bad NUMDATA number");
  217. X    return -1;
  218. X    }
  219. X
  220. X    mem[i] = (v << 24) | ((f & 3) << 16) | (p & 0xFFFF);
  221. X    /* DEBUGF(8, "line %3d: NUMDATA" C c); */
  222. X    return c + 1;
  223. X    }
  224. X
  225. Xint Ind(c)
  226. X    int c;
  227. X{
  228. X    return -1;
  229. X    }
  230. X
  231. X
  232. X
  233. END_OF_FILE
  234. if test 3692 -ne `wc -c <'LOME/Ifuncs1.c'`; then
  235.     echo shar: \"'LOME/Ifuncs1.c'\" unpacked with wrong size!
  236. fi
  237. # end of 'LOME/Ifuncs1.c'
  238. fi
  239. if test -f 'LOME/Ifuncs2.c' -a "${1}" != "-c" ; then 
  240.   echo shar: Will not clobber existing file \"'LOME/Ifuncs2.c'\"
  241. else
  242. echo shar: Extracting \"'LOME/Ifuncs2.c'\" \(3965 characters\)
  243. sed "s/^X//" >'LOME/Ifuncs2.c' <<'END_OF_FILE'
  244. X/*
  245. X * Ifuncs2.c
  246. X * SCM Interpreter Function set Two
  247. X * Copyright 1988 Darren New.
  248. X * All rights reserved.
  249. X */
  250. X
  251. X#include "PPL.h"
  252. X#include "MacroIO.h"
  253. X
  254. X#include "Interp.h"
  255. X
  256. X#define ERROR(s) {PLStatus(0,s); MStopIO(); return -1;}
  257. X
  258. Xint Es(c)           /* STOP $ */
  259. X    int c;
  260. X{
  261. X    char s[50];
  262. X    strcpy(s, "STOP $ ENCOUNTERED!");
  263. X    s[5] = param[0];
  264. X    /* DEBUGF(0, s); */
  265. X    PLStatus(4, s);
  266. X    Edebug(c);
  267. X    MStopIO();
  268. X    return -1;
  269. X    }
  270. X
  271. Xint Ec(c)       /* CALL $ */
  272. X    int c;
  273. X{
  274. X    if (subr[param[0]] == 0)
  275. X    ERROR("Call of non-existant subroutine");
  276. X    /* DEBUGF(8, "line %3d: CALL %d" C c C param[0]); */
  277. X    p[param[0]] = c + 1;
  278. X    return (int) subr[param[0]];
  279. X    }
  280. X
  281. Xint Egm(c)      /* GET MEM $ = $ */
  282. X    int c;
  283. X{
  284. X    short frm = p[param[1]], to = param[0];
  285. X    if (frm < 0 || frm >= MAXMEM)
  286. X    ERROR("GET MEM out of bounds");
  287. X    v[to] = ((mem[frm] >> 24) & 0xFF);
  288. X    f[to] = ((mem[frm] >> 16) & 0x03);
  289. X    p[to] = (mem[frm] & 0xFFFF);
  290. X    /* DEBUGF(8, "line %3d: GET MEM %c = %c                (src=%d, f=%d, v=%d, p=%d)" C c C
  291. X    param[0] C param[1] C frm C f[to] C v[to] C p[to]); */
  292. X    return c + 1;
  293. X    }
  294. X
  295. Xint Epm(c)      /* PUT MEM $ = $ */
  296. X    int c;
  297. X{
  298. X    short frm = param[1], to = p[param[0]];
  299. X    if (to < 0 || to >= MAXMEM)
  300. X    ERROR("PUT MEM out of bounds");
  301. X    mem[to] = (v[frm] << 24) | (f[frm] << 16) | (p[frm] & 0xFFFF);
  302. X    /* DEBUGF(8, "line %3d: GET MEM %c = %c                (dst=%d, f=%d, v=%d, p=%d)" C c C
  303. X    param[0] C param[1] C to C f[frm] C v[frm] C p[frm]); */
  304. X    return c + 1;
  305. X    }
  306. X
  307. Xint Ef(c)       /* FLG $ = $ */
  308. X    int c;
  309. X{
  310. X    f[param[0]] = f[param[1]];
  311. X    /* DEBUGF(8, "line %3d: FLG %c = %c                    (%d)" C c C
  312. X    param[0] C param[1] C f[param[0]]); */
  313. X    return c + 1;
  314. X    }
  315. X
  316. Xint Epv(c)      /* PTR $ = VAL $ */
  317. X    int c;
  318. X{
  319. X    p[param[0]] = (v[param[1]] & 0xFF);
  320. X    /* DEBUGF(8, "line %3d: PTR %c = VAL %c                (%d)" C c C
  321. X    param[0] C param[1] C p[param[0]]); */
  322. X    return c + 1;
  323. X    }
  324. X
  325. Xint Evp(c)      /* VAL $ = PTR $ */
  326. X    int c;
  327. X{
  328. X    v[param[0]] = (p[param[1]] & 0xFF);
  329. X    /* DEBUGF(8, "line %3d: VAL %c = PTR %c                (%d)" C c C
  330. X    param[0] C param[1] C v[param[0]]); */
  331. X    return c + 1;
  332. X    }
  333. X
  334. Xint Eva(c)      /* VAL $ = $ + $ */
  335. X    int c;
  336. X{
  337. X    v[param[0]] = (0xFF & (v[param[1]] + v[param[2]]));
  338. X    /* DEBUGF(8, "line %3d: VAL %c = %c + %c               (%d)" C c C
  339. X    param[0] C param[1] C param[2] C v[param[0]]); */
  340. X    return c + 1;
  341. X    }
  342. X
  343. Xint Evs(c)      /* VAL $ = $ - $ */
  344. X    int c;
  345. X{
  346. X    v[param[0]] = (0xFF & (v[param[1]] - v[param[2]]));
  347. X    /* DEBUGF(8, "line %3d: VAL %c = %c - %c               (%d)" C c C
  348. X    param[0] C param[1] C param[2] C v[param[0]]); */
  349. X    return c + 1;
  350. X    }
  351. X
  352. Xint Epa(c)      /* PTR $ = $ + $ */
  353. X    int c;
  354. X{
  355. X    p[param[0]] = p[param[1]] + p[param[2]];
  356. X    /* DEBUGF(8, "line %3d: PTR %c = %c + %c               (%d)" C c C
  357. X    param[0] C param[1] C param[2] C p[param[0]]); */
  358. X    return c + 1;
  359. X    }
  360. X
  361. Xint Eps(c)      /* PTR $ = $ - $ */
  362. X    int c;
  363. X{
  364. X    p[param[0]] = p[param[1]] - p[param[2]];
  365. X    /* DEBUGF(8, "line %3d: PTR %c = %c - %c               (%d)" C c C
  366. X    param[0] C param[1] C param[2] C p[param[0]]); */
  367. X    return c + 1;
  368. X    }
  369. X
  370. Xint Ept(c)      /* PTR $ = $ * $ */
  371. X    int c;
  372. X{
  373. X    p[param[0]] = p[param[1]] * p[param[2]];
  374. X    /* DEBUGF(8, "line %3d: PTR %c = %c * %c               (%d)" C c C
  375. X    param[0] C param[1] C param[2] C p[param[0]]); */
  376. X    return c + 1;
  377. X    }
  378. X
  379. Xint Epd(c)      /* PTR $ = $ / $ */
  380. X    int c;
  381. X{
  382. X    if (p[param[2]] == 0) ERROR("Attempted division by zero!");
  383. X    p[param[0]] = p[param[1]] / p[param[2]];
  384. X    /* DEBUGF(8, "line %3d: PTR %c = %c / %c               (%d)" C c C
  385. X    param[0] C param[1] C param[2] C p[param[0]]); */
  386. X    return c + 1;
  387. X    }
  388. X
  389. Xint Empb(c)     /* MOV PTR $ BY $ */
  390. X    int c;
  391. X{
  392. X    p[param[0]] += p[param[1]];
  393. X    /* DEBUGF(8, "line %3d: MOV PTR %c BY %c               (by %d, now %d)" C c C
  394. X    param[0] C param[1] C p[param[1]] C p[param[0]]); */
  395. X    return c + 1;
  396. X    }
  397. X
  398. X
  399. END_OF_FILE
  400. if test 3965 -ne `wc -c <'LOME/Ifuncs2.c'`; then
  401.     echo shar: \"'LOME/Ifuncs2.c'\" unpacked with wrong size!
  402. fi
  403. # end of 'LOME/Ifuncs2.c'
  404. fi
  405. if test -f 'LOME/Ifuncs3.c' -a "${1}" != "-c" ; then 
  406.   echo shar: Will not clobber existing file \"'LOME/Ifuncs3.c'\"
  407. else
  408. echo shar: Extracting \"'LOME/Ifuncs3.c'\" \(2594 characters\)
  409. sed "s/^X//" >'LOME/Ifuncs3.c' <<'END_OF_FILE'
  410. X/*
  411. X * Ifuncs3.c
  412. X * SCM Interpreter Function set Three
  413. X * Copyright 1988 Darren New.
  414. X * All rights reserved.
  415. X */
  416. X
  417. X#include "PPL.h"
  418. X#include "MacroIO.h"
  419. X
  420. X#include "Interp.h"
  421. X
  422. X#define ERROR(s) {PLStatus(0,s); MStopIO(); return -1;}
  423. X
  424. X
  425. Xstatic int getnum(void);
  426. Xstatic int getnum()
  427. X{
  428. X    short i = PLToInt(param[0]) * 10 + PLToInt(param[1]);
  429. X    if (i < 1 || i > 99 || labl[i] == 0)
  430. X    ERROR("TO or TO IF with bad label");
  431. X    return (int) labl[i];
  432. X    }
  433. X
  434. Xint Et(c)       /* TO $$ */
  435. X    int c;
  436. X{
  437. X    /* DEBUGF(8, "line %3d: TO %c%c" C c C param[0] C param[1]); */
  438. X    return getnum();
  439. X    }
  440. X
  441. Xint Etife(c)    /* TO $$ IF FLG $ EQ $ */
  442. X    int c;
  443. X{
  444. X    /* DEBUGF(8, "line %3d: TO %c%c IF FLG %c EQ %c        (%d eq %d)" C c C
  445. X    param[0] C param[1] C param[2] C param[3] C f[param[2]] C f[param[3]]); */
  446. X    if (f[param[2]] == f[param[3]])
  447. X    return getnum();
  448. X    return c + 1;
  449. X    }
  450. X
  451. Xint Etifn(c)    /* TO $$ IF FLG $ NE $ */
  452. X    int c;
  453. X{
  454. X    /* DEBUGF(8, "line %3d: TO %c%c IF FLG %c NE %c        (%d ne %d)" C c C
  455. X    param[0] C param[1] C param[2] C param[3] C f[param[2]] C f[param[3]]); */
  456. X    if (f[param[2]] != f[param[3]])
  457. X    return getnum();
  458. X    return c + 1;
  459. X    }
  460. X
  461. Xint Etive(c)    /* TO $$ IF VAL $ EQ $ */
  462. X    int c;
  463. X{
  464. X    /* DEBUGF(8, "line %3d: TO %c%c IF VAL %c EQ %c        (%d eq %d)" C c C
  465. X    param[0] C param[1] C param[2] C param[3] C v[param[2]] C v[param[3]]); */
  466. X    if (v[param[2]] == v[param[3]])
  467. X    return getnum();
  468. X    return c + 1;
  469. X    }
  470. X
  471. Xint Etivn(c)    /* TO $$ IF VAL $ NE $ */
  472. X    int c;
  473. X{
  474. X    /* DEBUGF(8, "line %3d: TO %c%c IF VAL %c NE %c        (%d ne %d)" C c C
  475. X    param[0] C param[1] C param[2] C param[3] C v[param[2]] C v[param[3]]); */
  476. X    if (v[param[2]] != v[param[3]])
  477. X    return getnum();
  478. X    return c + 1;
  479. X    }
  480. X
  481. Xint Etipe(c)    /* TO $$ IF PTR $ EQ $ */
  482. X    int c;
  483. X{
  484. X    /* DEBUGF(8, "line %3d: TO %c%c IF PTR %c EQ %c        (%d eq %d)" C c C
  485. X    param[0] C param[1] C param[2] C param[3] C p[param[2]] C p[param[3]]); */
  486. X    if (p[param[2]] == p[param[3]])
  487. X    return getnum();
  488. X    return c + 1;
  489. X    }
  490. X
  491. Xint Etipn(c)    /* TO $$ IF PTR $ NE $ */
  492. X    int c;
  493. X{
  494. X    /* DEBUGF(8, "line %3d: TO %c%c IF PTR %c NE %c        (%d ne %d)" C c C
  495. X    param[0] C param[1] C param[2] C param[3] C p[param[2]] C p[param[3]]); */
  496. X    if (p[param[2]] != p[param[3]])
  497. X    return getnum();
  498. X    return c + 1;
  499. X    }
  500. X
  501. Xint Etipl(c)    /* TO $$ IF PTR $ LT $ */
  502. X    int c;
  503. X{
  504. X    /* DEBUGF(8, "line %3d: TO %c%c IF PTR %c LE %c        (%d le %d)" C c C
  505. X    param[0] C param[1] C param[2] C param[3] C p[param[2]] C p[param[3]]); */
  506. X    if (p[param[2]] < p[param[3]])
  507. X    return getnum();
  508. X    return c + 1;
  509. X    }
  510. X
  511. X
  512. END_OF_FILE
  513. if test 2594 -ne `wc -c <'LOME/Ifuncs3.c'`; then
  514.     echo shar: \"'LOME/Ifuncs3.c'\" unpacked with wrong size!
  515. fi
  516. # end of 'LOME/Ifuncs3.c'
  517. fi
  518. if test -f 'LOME/Ifuncs4.c' -a "${1}" != "-c" ; then 
  519.   echo shar: Will not clobber existing file \"'LOME/Ifuncs4.c'\"
  520. else
  521. echo shar: Extracting \"'LOME/Ifuncs4.c'\" \(2846 characters\)
  522. sed "s/^X//" >'LOME/Ifuncs4.c' <<'END_OF_FILE'
  523. X/*
  524. X * Ifuncs4.c
  525. X * SCM Interpreter Function set Four
  526. X * Copyright 1988 Darren New.
  527. X * All rights reserved.
  528. X */
  529. X
  530. X#include "PPL.h"
  531. X#include "MacroIO.h"
  532. X
  533. X#include "Interp.h"
  534. X
  535. Xint Er(c)       /* REWIND $ */
  536. X    int c;
  537. X{
  538. X    f[param[0]] = (M_OK == MRewind(v[param[0]]));
  539. X    /* DEBUGF(8, "line %3d: REWIND %c                      (VAL %c=%d, FLG %c=%d)" C
  540. X    c C param[0] C param[0] C v[param[0]] C param[0] C f[param[0]]); */
  541. X    return c + 1;
  542. X    }
  543. X
  544. Xint Egb(c)      /* GET BUFF $ */
  545. X    int c;
  546. X{
  547. X    f[param[0]] = MGetBuff(v[param[0]]);
  548. X    /* DEBUGF(8, "line %3d: GET BUFF %c                    (VAL %c=%d, FLG %c=%d)" C
  549. X    c C param[0] C param[0] C v[param[0]] C param[0] C f[param[0]]); */
  550. X    return c + 1;
  551. X    }
  552. X
  553. Xint Epb(c)      /* PUT BUFF $ */
  554. X    int c;
  555. X{
  556. X    f[param[0]] = MPutBuff(v[param[0]]);
  557. X    /* DEBUGF(8, "line %3d: PUT BUFF %c                    (VAL %c=%d, FLG %c=%d)" C
  558. X    c C param[0] C param[0] C v[param[0]] C param[0] C f[param[0]]); */
  559. X    return c + 1;
  560. X    }
  561. X
  562. Xint Evi(c)      /* VAL $ = INPUT */
  563. X    int c;
  564. X{
  565. X    v[param[0]] = MGetChar();
  566. X    /* DEBUGF(8, "line %3d: VAL %c = INPUT                 (VAL %c=%d=`%c')" C
  567. X    c C param[0] C param[0] C v[param[0]] C v[param[0]]); */
  568. X    return c + 1;
  569. X    }
  570. X
  571. Xint Eov(c)      /* OUTPUT = VAL $ */
  572. X    int c;
  573. X{
  574. X    v[param[0]] = MPutChar(v[param[0]]);
  575. X    /* DEBUGF(8, "line %3d: OUTPUT = VAL %c                (VAL %c=%d=`%c')" C
  576. X    c C param[0] C param[0] C v[param[0]] C v[param[0]]); */
  577. X    return c + 1;
  578. X    }
  579. X
  580. Xint Edebug(c)   /* DEBUG */
  581. X    int c;
  582. X{
  583. X    unsigned short i;
  584. X    unsigned short x, y, z;
  585. X
  586. X    /* DEBUG_SETDEFS("RAW:0/190/640/200/Debug window", "T:DBugOut"); */
  587. X    /* DEBUG_ENTER("DEBUG DUMP", "LINE %d" C c); */
  588. X    for (i = '0'; i <= '9'; i++) {
  589. X    x = isprint(v[i]) ? v[i] : '?';
  590. X    /* DEBUGF(8, "Register %c: f=%d, v=%3d=%c, p=%d" C
  591. X        i C f[i] C v[i] C x C p[i]); */
  592. X    }
  593. X    for (i = 'A'; i <= 'Z'; i++) {
  594. X    x = isprint(v[i]) ? v[i] : '?';
  595. X    /* DEBUGF(8, "Register %c: f=%d, v=%3d=%c, p=%d" C
  596. X        i C f[i] C v[i] C x C p[i]); */
  597. X    }
  598. X    for (i = 0; i < MAXMEM; i++) {
  599. X    x = ((mem[i] >> 16) & 0x03);
  600. X    y = ((mem[i] >> 24) & 0xFF);
  601. X    z = (mem[i] & 0xFFFF);
  602. X    if (x || y || z) {
  603. X        /* DEBUGF(8, "M[%04d]=%d:%3d(%c):%4d" C
  604. X        i C x C y C isprint(y) ? y : '?' C z); */
  605. X        }
  606. X    }
  607. X
  608. X    /* DEBUG_RETURN(NULL); */
  609. X    return c + 1;
  610. X    }
  611. X
  612. Xint Emt(c)      /* MESSAGE $$$$ TO $ */
  613. X    int c;
  614. X{
  615. X    int temp;
  616. X    MPutChar(0);
  617. X    for (temp = 0; temp < 20; temp++)
  618. X    MPutChar('*');
  619. X    MPutChar(' ');
  620. X    MPutChar(param[0]);
  621. X    MPutChar(param[1]);
  622. X    MPutChar(param[2]);
  623. X    MPutChar(param[3]);
  624. X    MPutChar(' ');
  625. X    MPutChar('E');
  626. X    MPutChar('R');
  627. X    MPutChar('R');
  628. X    MPutChar('O');
  629. X    MPutChar('R');
  630. X    MPutChar('!');
  631. X    MPutChar(0);
  632. X    f[param[4]] = MPutBuff(v[param[4]]);
  633. X    /* DEBUGF(8, "line %3d: MESSAGE %4s TO %c" C c C param C param[4]); */
  634. X    return c + 1;
  635. X    }
  636. X
  637. X
  638. END_OF_FILE
  639. if test 2846 -ne `wc -c <'LOME/Ifuncs4.c'`; then
  640.     echo shar: \"'LOME/Ifuncs4.c'\" unpacked with wrong size!
  641. fi
  642. # end of 'LOME/Ifuncs4.c'
  643. fi
  644. if test -f 'LOME/LOME.c' -a "${1}" != "-c" ; then 
  645.   echo shar: Will not clobber existing file \"'LOME/LOME.c'\"
  646. else
  647. echo shar: Extracting \"'LOME/LOME.c'\" \(2808 characters\)
  648. sed "s/^X//" >'LOME/LOME.c' <<'END_OF_FILE'
  649. X/*
  650. X * LOME.c
  651. X * Line Oriented Macro Expander data declaration file
  652. X * Copyright 1989 Darren New
  653. X *
  654. X */
  655. X
  656. X#include "LOME.h"
  657. X
  658. Xchar params[O_last]; /* inputted parameter string */
  659. X
  660. Xunsigned char * macrochar;    /* chars of macros (dyn alc) */
  661. Xunsigned char * macroflag;    /* flags of macros (dyn alc) */
  662. Xmoffs macrosize;         /* size of macros loaded */
  663. X
  664. Xstr varname[MAXvarnames];     /* names of variables */
  665. Xstr varval[MAXvarnames];     /* values of variables */
  666. X
  667. Xstr ustack[MAXustack];         /* values of user stack */
  668. Xshort ustacksize;         /* # items on ustack */
  669. X
  670. Xstruct traceback_struct tstack[MAXnests]; /* traceback stack */
  671. Xint tstacksize;          /* traceback stack size */
  672. X
  673. Xshort sstack[MAXstreams];     /* input stream stack */
  674. Xshort sstacksize;         /* # items on sstack */
  675. X
  676. Xshort outstream;         /* current output stream */
  677. Xshort instream;          /* current input stream */
  678. X
  679. Xchar  consline[BIGLINE];     /* constructed line */
  680. Xshort conslinesize;         /* chars on cons line */
  681. X
  682. Xlong symgenval;          /* symbol generator value */
  683. X
  684. Xlong skipping;             /* skip value flag */
  685. X
  686. Xbool quitting;             /* abnormally exitting */
  687. X
  688. X
  689. X#if HIDPROTS
  690. XHIDDEN void InitMemory ARGS((void));
  691. X#endif
  692. X
  693. XHIDDEN void InitMemory()
  694. X{
  695. X    /* output initially goes to stream 3 */
  696. X    outstream = 3;
  697. X
  698. X    /* allocate memory for macro text */
  699. X    macrochar = (unsigned char *)
  700. X        PLAllocMem(MAXmacrochars, PLalloc_zero | PLalloc_die);
  701. X    macroflag = (unsigned char *)
  702. X        PLAllocMem(MAXmacrochars, PLalloc_zero | PLalloc_die);
  703. X    macrosize = 0;
  704. X
  705. X    /* not abnormally quitting yet */
  706. X    quitting = FALSE;
  707. X
  708. X    }
  709. X
  710. X#if HIDPROTS
  711. XHIDDEN void CleanUp ARGS((void));
  712. X#endif
  713. X
  714. XHIDDEN void CleanUp()
  715. X{
  716. X    int j;
  717. X
  718. X    if (macrochar) PLFreeMem(macrochar);
  719. X    if (macroflag) PLFreeMem(macroflag);
  720. X
  721. X    for (j = 0; j < MAXvarnames; j++) {
  722. X    if (varname[j])
  723. X        PLFreeMem(varname[j]);
  724. X    if (varval[j])
  725. X        PLFreeMem(varval[j]);
  726. X    }
  727. X
  728. X    for (j = 0; j < MAXustack; j++)
  729. X    if (ustack[j])
  730. X        PLFreeMem(ustack[j]);
  731. X
  732. X    for (j = 0; j < MAXnests; j++) {
  733. X    if (Sinp) PLFreeMem(Sinp);
  734. X    if (Sp0) PLFreeMem(Sp0);
  735. X    if (Sp1) PLFreeMem(Sp1);
  736. X    if (Sp2) PLFreeMem(Sp2);
  737. X    if (Sp3) PLFreeMem(Sp3);
  738. X    if (Sp4) PLFreeMem(Sp4);
  739. X    if (Sp5) PLFreeMem(Sp5);
  740. X    if (Sp6) PLFreeMem(Sp6);
  741. X    if (Sp7) PLFreeMem(Sp7);
  742. X    if (Sp8) PLFreeMem(Sp8);
  743. X    if (Sp9) PLFreeMem(Sp9);
  744. X    }
  745. X
  746. X    }
  747. X
  748. X
  749. Xint AssertExit()
  750. X{
  751. X    TraceBack();
  752. X    CleanUp();
  753. X    MStopIO();
  754. X    PLExit(PLsev_bomb);
  755. X    return 0;
  756. X    }
  757. X
  758. Xint BombExit()
  759. X{
  760. X    return AssertExit();
  761. X    }
  762. X
  763. Xint FaultExit()
  764. X{
  765. X    return AssertExit();
  766. X    }
  767. X
  768. Xshort DoIt()
  769. X{
  770. X    bool loadok;
  771. X
  772. X    MStartIO(PLargcnt, PLarglist);
  773. X
  774. X    InitMemory();
  775. X    loadok = LoadMacros(1); /* macros are loaded from stream one */
  776. X    MRewind(1);
  777. X
  778. X    if (loadok)
  779. X    ParseFiles(2);  /* sources are loaded from stream two to start */
  780. X
  781. X    CleanUp();
  782. X
  783. X    MStopIO();
  784. X    return PLsev_normal;
  785. X
  786. X    }
  787. X
  788. END_OF_FILE
  789. if test 2808 -ne `wc -c <'LOME/LOME.c'`; then
  790.     echo shar: \"'LOME/LOME.c'\" unpacked with wrong size!
  791. fi
  792. # end of 'LOME/LOME.c'
  793. fi
  794. if test -f 'LOME/LOME2.c' -a "${1}" != "-c" ; then 
  795.   echo shar: Will not clobber existing file \"'LOME/LOME2.c'\"
  796. else
  797. echo shar: Extracting \"'LOME/LOME2.c'\" \(2881 characters\)
  798. sed "s/^X//" >'LOME/LOME2.c' <<'END_OF_FILE'
  799. X/*
  800. X * LOME2.c
  801. X * Line Oriented Macro Expander - ParseFiles()
  802. X * Copyright 1989 Darren New
  803. X *
  804. X */
  805. X
  806. X#include "LOME.h"
  807. X
  808. X
  809. X/* Some apologies are in order here: these functions are all void and
  810. X   all declare temporaries in the innermost place possible. They also
  811. X   all communicate through globals. HOWEVER, this was done intentionally
  812. X   to make reimplementing these algorithms in SCM easier. Sorry. */
  813. X
  814. X
  815. X#ifdef HIDPROTS
  816. XHIDDEN void OutputLine ARGS((void));
  817. X#endif
  818. X
  819. XHIDDEN void OutputLine()
  820. X{
  821. X    /* outputs the line that failed to match on TOS */
  822. X
  823. X    int i;
  824. X    assert(0 < tstacksize);
  825. X    assert(Sinp != NULL);
  826. X    MPutChar(0);    /* clear buffer */
  827. X    for (i = 0; Sinp[i]; i++)
  828. X    MPutChar(Sinp[i]);
  829. X    MPutChar(0);
  830. X    i = MPutBuff(outstream);
  831. X    }
  832. X
  833. X#ifdef HIDPROTS
  834. XHIDDEN void ParseStack ARGS((void));
  835. X#endif
  836. X
  837. XHIDDEN void ParseStack()
  838. X{
  839. X    assert(0 <= tstacksize);
  840. X
  841. X    while (tstacksize && ! quitting) {
  842. X    /* look for line only once, else returns cause starting over */
  843. X    if (Sretoffs < 0)
  844. X        FindMatch();
  845. X    if (Sretoffs < 0) {    /* no match found */
  846. X        if (    (params[O_ZERO] + 2 == params[O_FMATCH]) ||
  847. X            (params[O_ZERO] + 1 == params[O_FMATCH] &&
  848. X            1 == tstacksize) ) {
  849. X        Message("NONE");
  850. X        TraceBack();
  851. X        }
  852. X        else {
  853. X        OutputLine();
  854. X        PopTStack();
  855. X        }
  856. X        }
  857. X    else {        /* match found - expand body lines */
  858. X        ExpandLine();
  859. X        }
  860. X    }
  861. X
  862. X    }
  863. X
  864. X#ifdef HIDPROTS
  865. XHIDDEN void StripHEOL ARGS((str s));
  866. X#endif
  867. X
  868. XHIDDEN void StripHEOL ARGS1(str,s)
  869. X{
  870. X    /* removes any trailing escape and chops off HEOL and on */
  871. X    int i;
  872. X
  873. X    assert(s != NULL);
  874. X    i = 0;
  875. X    while (s[i]) {
  876. X    if (s[i] == params[O_ESC] && s[i+1])
  877. X        i += 2;
  878. X    else if (s[i] == params[O_ESC])
  879. X        s[i] = 0;
  880. X    else if (s[i] == params[O_HEOL])
  881. X        s[i] = 0;
  882. X    else
  883. X        i += 1;
  884. X    }
  885. X    }
  886. X
  887. X
  888. Xvoid AddLineToStack ARGS1(str,line)
  889. X{
  890. X    /* makes a copy of line and stacks it on traceback stack */
  891. X    tstacksize += 1;
  892. X    if (MAXnests <= tstacksize) {
  893. X    Message("NEST");
  894. X    tstacksize -= 1;
  895. X    TraceBack();
  896. X    }
  897. X    else {
  898. X    inx i;
  899. X    Sinp = PLStrDup(line);
  900. X    for (i = 0; i < 10; i++)
  901. X        Sp[i] = NULL;
  902. X    Sretoffs = -1;
  903. X    }
  904. X    }
  905. X
  906. X
  907. Xvoid ParseFiles ARGS1(int,origstream)
  908. X{
  909. X    char line[BIGLINE];
  910. X
  911. X    assert(0 <= origstream && origstream <= 9);
  912. X    assert(macroflag != NULL);
  913. X    assert(macrochar != NULL);
  914. X    assert(0 < macrosize);
  915. X
  916. X    sstack[0] = instream = origstream;
  917. X    sstacksize = 1;
  918. X
  919. X    while (sstacksize && ! quitting) {
  920. X    int i = MGetBuff(instream);
  921. X    if (i == M_EOF || i == M_ILLEGAL) {
  922. X        if (i == M_ILLEGAL)
  923. X        Message("IOER");
  924. X        sstacksize -= 1;
  925. X        if (sstacksize)
  926. X        instream = sstack[sstacksize-1];
  927. X        else
  928. X        instream = 0;
  929. X        }
  930. X    else {    /* read was OK */
  931. X        assert(0 <= skipping);
  932. X        if (skipping) {
  933. X        skipping -= 1;
  934. X        }
  935. X        else {
  936. X        int i = 0;
  937. X        do {
  938. X            line[i] = MGetChar();
  939. X            } while (line[i++]);
  940. X        StripHEOL(line);
  941. X        AddLineToStack(line);
  942. X        ParseStack();
  943. X        }
  944. X        }
  945. X    }
  946. X
  947. X    }
  948. X
  949. X
  950. X
  951. END_OF_FILE
  952. if test 2881 -ne `wc -c <'LOME/LOME2.c'`; then
  953.     echo shar: \"'LOME/LOME2.c'\" unpacked with wrong size!
  954. fi
  955. # end of 'LOME/LOME2.c'
  956. fi
  957. if test -f 'LOME/LOME7.c' -a "${1}" != "-c" ; then 
  958.   echo shar: Will not clobber existing file \"'LOME/LOME7.c'\"
  959. else
  960. echo shar: Extracting \"'LOME/LOME7.c'\" \(2597 characters\)
  961. sed "s/^X//" >'LOME/LOME7.c' <<'END_OF_FILE'
  962. X/*
  963. X * LOME7.c
  964. X * Line Oriented Macro Expander - DoSubsOp()
  965. X * Copyright 1989 Darren New
  966. X *
  967. X */
  968. X
  969. X#include "LOME.h"
  970. X
  971. Xvoid DoSubsOp ARGS2(int,p /* the parameter number */,int,op /* the operation number */)
  972. X{
  973. X    extern void DoMath ARGS((int p));
  974. X
  975. X    assert(0 < tstacksize);
  976. X    assert(0 <= p && p <= 9);
  977. X    assert(0 <= op && op <= 9);
  978. X
  979. X    switch (op) {
  980. X
  981. X    case 0: {
  982. X        int i;
  983. X        if (Sp[p] != NULL && *Sp[p] != 0) {
  984. X        for (i = 0; Sp[p][i]; i++)
  985. X            ADDTOLINE(Sp[p][i]);
  986. X        ENDLINE();
  987. X        }
  988. X        break;
  989. X        }
  990. X
  991. X    case 1: {
  992. X        char * l, * r;
  993. X        if (Sp[p] != NULL && *Sp[p] != 0) {
  994. X        for (l = Sp[p]; *l && *l == ' '; l += 1)
  995. X            /* look for first non-blank */;
  996. X        for (r = Sp[p] + strlen(Sp[p]) - 1;
  997. X                r >= l && *r == ' '; r -= 1)
  998. X            /* look for last non-blank */;
  999. X        if (    (*l == params[O_OP] && *r == params[O_CP]) ||
  1000. X            (*l == params[O_OQ] && *r == params[O_CQ])) {
  1001. X            l += 1; r -= 1;
  1002. X            }
  1003. X        while (l <= r)
  1004. X            ADDTOLINE(*l++);
  1005. X        ENDLINE();
  1006. X        }
  1007. X        break;
  1008. X        }
  1009. X
  1010. X    case 2: {
  1011. X        DoMath(p);
  1012. X        break;
  1013. X        }
  1014. X
  1015. X    case 3: {
  1016. X        char * pnt;
  1017. X        if (Sp[p] != NULL && *Sp[p] != 0) {
  1018. X        pnt = VarLookup(Sp[p]);
  1019. X        if (pnt != NULL && *pnt != 0) {
  1020. X            while (*pnt)
  1021. X            ADDTOLINE(*pnt++);
  1022. X            ENDLINE();
  1023. X            }
  1024. X        }
  1025. X        break;
  1026. X        }
  1027. X
  1028. X    case 4: {
  1029. X        char * p1;
  1030. X        char * p2;
  1031. X
  1032. X        p1 = Sp[p];
  1033. X        if (p1 && *p1 == 0) p1 = NULL;
  1034. X
  1035. X        if (p1 != NULL) p2 = VarLookup(p1);
  1036. X        else p2 = NULL;
  1037. X
  1038. X        if (p2 != NULL && *p2 == 0) p2 = NULL;
  1039. X
  1040. X        /* now, p2 != NULL iff var already has value set */
  1041. X
  1042. X        if (p2 != NULL) {
  1043. X        while (*p2)
  1044. X            ADDTOLINE(*p2++);
  1045. X        ENDLINE();
  1046. X        }
  1047. X        else {
  1048. X        long value = symgenval++;
  1049. X        short oldlen = conslinesize;
  1050. X
  1051. X        InsNumber(value);
  1052. X
  1053. X        if (p1 != NULL)
  1054. X            VarSetVal(p1, &consline[oldlen]);
  1055. X        }
  1056. X        break;
  1057. X        }
  1058. X
  1059. X    case 5: {
  1060. X        long val;
  1061. X
  1062. X        if (Sp[p] != NULL)
  1063. X        val = *Sp[p];
  1064. X        else
  1065. X        val = 0;
  1066. X
  1067. X        InsNumber(val);
  1068. X
  1069. X        break;
  1070. X        }
  1071. X
  1072. X    case 6: {
  1073. X        long val;
  1074. X
  1075. X        if (Sp[p] != NULL)
  1076. X        val = strlen(Sp[p]);
  1077. X        else
  1078. X        val = 0;
  1079. X
  1080. X        InsNumber(val);
  1081. X
  1082. X        break;
  1083. X        }
  1084. X
  1085. X    case 7: {
  1086. X        if (Sp[p] != NULL)
  1087. X        PLFreeMem(Sp[p]);
  1088. X
  1089. X        ENDLINE();
  1090. X        Sp[p] = PLStrDup(consline);
  1091. X        consline[conslinesize = 0] = 0;
  1092. X        if (macroflag[Sretoffs] == 2)   /* skip trailing BEOL if there */
  1093. X        Sretoffs += 1;
  1094. X        break;
  1095. X        }
  1096. X
  1097. X    case 8: {
  1098. X        if (Sp[p] != NULL && *Sp[p] != 0)
  1099. X        VarSetVal(Sp[p], consline);
  1100. X        consline[conslinesize = 0] = 0;
  1101. X        if (macroflag[Sretoffs] == 2)   /* skip trailing BEOL if there */
  1102. X        Sretoffs += 1;
  1103. X        break;
  1104. X        }
  1105. X
  1106. X    case 9: {
  1107. X        Message("NYET");
  1108. X        TraceBack();
  1109. X        break;
  1110. X        }
  1111. X
  1112. X    }
  1113. X
  1114. X    }
  1115. X
  1116. X
  1117. END_OF_FILE
  1118. if test 2597 -ne `wc -c <'LOME/LOME7.c'`; then
  1119.     echo shar: \"'LOME/LOME7.c'\" unpacked with wrong size!
  1120. fi
  1121. # end of 'LOME/LOME7.c'
  1122. fi
  1123. if test -f 'LOME/MacroIO.c' -a "${1}" != "-c" ; then 
  1124.   echo shar: Will not clobber existing file \"'LOME/MacroIO.c'\"
  1125. else
  1126. echo shar: Extracting \"'LOME/MacroIO.c'\" \(3707 characters\)
  1127. sed "s/^X//" >'LOME/MacroIO.c' <<'END_OF_FILE'
  1128. X/*
  1129. X * MacroIO.c
  1130. X * Macro I/O Subsystem code file
  1131. X * Copyright 1988 Darren New.
  1132. X * All rights reserved.
  1133. X */
  1134. X
  1135. X#include "PPL.h"
  1136. X#include "TFS.h"
  1137. X
  1138. X#include "MacroIO.h"
  1139. X
  1140. Xshort MEchoFlag;
  1141. X
  1142. XHIDDEN char linebuff[BIGLINE];
  1143. XHIDDEN short ccp;
  1144. X
  1145. XHIDDEN int namecount;
  1146. XHIDDEN TFSfile stream[10];
  1147. XHIDDEN str name[10];
  1148. XHIDDEN char mode[10];        /* C = closed, R = reading, W = writing */
  1149. XHIDDEN char scratch[10];    /* 1 = discard on close */
  1150. X
  1151. XHIDDEN bool initted;
  1152. X
  1153. X
  1154. Xint MGetBuff ARGS1(int,which)
  1155. X{
  1156. X    int i;
  1157. X
  1158. X    PLErrClr();
  1159. X
  1160. X    ccp = 0; linebuff[ccp] = 0;
  1161. X
  1162. X    if (which == 0) return M_EOF;
  1163. X
  1164. X    if (which < 0 || 9 < which) return M_ILLEGAL;
  1165. X
  1166. X    if (mode[which] == 'C') {   /* must open */
  1167. X    stream[which] = TFSOpen(name[which], scratch[which] ? "RCD" : "RC");
  1168. X    if (stream[which] != 0)
  1169. X        mode[which] = 'R';
  1170. X    else {
  1171. X        return M_ILLEGAL;
  1172. X        }
  1173. X    }
  1174. X    if (mode[which] == 'W')
  1175. X    return M_ILLEGAL;
  1176. X    i = TFSRead(stream[which], linebuff);
  1177. X    if (i == -1) {
  1178. X    if (PLerr == PLerr_eod) {
  1179. X        PLErrClr();
  1180. X        return M_EOF;
  1181. X        }
  1182. X    else {
  1183. X        return M_ILLEGAL;
  1184. X        }
  1185. X    }
  1186. X
  1187. X    if (MEchoFlag)
  1188. X    PLStatus(6, linebuff);
  1189. X
  1190. X    return M_OK;
  1191. X    }
  1192. X
  1193. X
  1194. Xint MPutBuff ARGS1(int,which)
  1195. X{
  1196. X    int i;
  1197. X
  1198. X    PLErrClr();
  1199. X
  1200. X    ccp = 0;
  1201. X
  1202. X    if (which == 0) return M_OK;
  1203. X
  1204. X    if (which < 0 || 9 < which) return M_ILLEGAL;
  1205. X
  1206. X    if (mode[which] == 'C') {   /* must open */
  1207. X    stream[which] = TFSOpen(name[which], scratch[which] ? "WCTD" : "WCT");
  1208. X    if (stream[which] != 0)
  1209. X        mode[which] = 'W';
  1210. X    else {
  1211. X        return M_ILLEGAL;
  1212. X        }
  1213. X    }
  1214. X    if (mode[which] == 'R') {
  1215. X    return M_ILLEGAL;
  1216. X    }
  1217. X    i = TFSWrite(stream[which], linebuff);
  1218. X    if (i == -1) {
  1219. X    if (PLerr == PLerr_eod) {
  1220. X        PLErrClr();
  1221. X        return M_EOF;
  1222. X        }
  1223. X    else {
  1224. X        return M_ILLEGAL;
  1225. X        }
  1226. X    }
  1227. X
  1228. X    return M_OK;
  1229. X    }
  1230. X
  1231. X
  1232. Xint MPutChar ARGS1(int,chr)
  1233. X{
  1234. X    assert(0 <= ccp);
  1235. X
  1236. X    if (ccp == BIGLINE - 1)
  1237. X    return 0;
  1238. X
  1239. X    chr = chr & 0xFF;
  1240. X    linebuff[ccp++] = chr;
  1241. X
  1242. X    if (chr == 0) ccp = 0;
  1243. X
  1244. X    return chr;
  1245. X    }
  1246. X
  1247. X
  1248. Xint MGetChar ARGS0()
  1249. X{
  1250. X    char c;
  1251. X
  1252. X    assert(0 <= ccp);
  1253. X    assert(ccp < BIGLINE);
  1254. X
  1255. X    c = 0xFF & linebuff[ccp++];
  1256. X    if (c == 0) ccp = 0;
  1257. X    return (int) c;
  1258. X    }
  1259. X
  1260. X
  1261. Xint MRewind ARGS1(int,which)
  1262. X{
  1263. X
  1264. X    PLErrClr();
  1265. X
  1266. X    if (which == 0) return M_OK;
  1267. X
  1268. X    if (which < 0 || 9 < which) return M_ILLEGAL;
  1269. X
  1270. X    if (mode[which] != 'C') {
  1271. X    TFSClose(stream[which]);
  1272. X    stream[which] = 0;
  1273. X    mode[which] = 'C';
  1274. X    }
  1275. X    return M_OK;
  1276. X    }
  1277. X
  1278. X
  1279. Xint MRename ARGS2(int,which,str,newname)
  1280. X{
  1281. X    TFSfile j;
  1282. X
  1283. X    assert(newname != NULL);
  1284. X
  1285. X    PLErrClr();
  1286. X
  1287. X    if (which == 0) return M_ILLEGAL;
  1288. X
  1289. X    if (which < 0 || 9 < which) return M_ILLEGAL;
  1290. X
  1291. X    if (mode[which] != 'C') {
  1292. X    if (scratch[which])
  1293. X        TFSDestroy(stream[which]);
  1294. X    else
  1295. X        TFSClose(stream[which]);
  1296. X    }
  1297. X    else if (scratch[which]) {
  1298. X    /* closed scratch file to be discarded */
  1299. X    j = TFSOpen(name[which], "D");
  1300. X    if (j) TFSDestroy(j);
  1301. X    }
  1302. X
  1303. X    mode[which] = 'C';
  1304. X    scratch[which] = 0;
  1305. X
  1306. X    PLFreeMem(name[which]);
  1307. X    name[which] = PLStrDup(newname);
  1308. X
  1309. X    return M_OK;
  1310. X    }
  1311. X
  1312. X
  1313. Xint MStartIO ARGS2(int,argc,str*,argv)
  1314. X{
  1315. X    inx i;
  1316. X
  1317. X    PLErrClr();
  1318. X
  1319. X    initted = ! TFSHasBeenInit();
  1320. X    if (initted) TFSInit();
  1321. X
  1322. X
  1323. X    name[0] = "::::";       /* should never get referenced */
  1324. X
  1325. X    for (i = 0; i < argc; i++) {
  1326. X    name[i+1] = PLStrDup(argv[i]);
  1327. X    }
  1328. X
  1329. X    namecount = ++i;
  1330. X
  1331. X    while (i < 10) {
  1332. X    name[i] = PLStrDup("t:TEMP?");
  1333. X    name[i][6] = i + '0';
  1334. X    scratch[i] = 1;
  1335. X    i += 1;
  1336. X    }
  1337. X    for (i = 0; i < 10; i++)
  1338. X    mode[i] = 'C';
  1339. X
  1340. X    return 0;
  1341. X    }
  1342. X
  1343. X
  1344. Xint MStopIO ARGS0()
  1345. X{
  1346. X    inx i;
  1347. X
  1348. X    PLErrClr();
  1349. X
  1350. X    for (i = 1; i < 10; i++) {
  1351. X    if (stream[i]) {
  1352. X        if (scratch[i])
  1353. X        TFSDestroy(stream[i]);
  1354. X        else
  1355. X        TFSClose(stream[i]);
  1356. X        }
  1357. X    PLFreeMem(name[i]);
  1358. X    }
  1359. X
  1360. X    if (initted) TFSTerm();
  1361. X    initted = FALSE;
  1362. X
  1363. X    return 0;
  1364. X    }
  1365. X
  1366. X
  1367. END_OF_FILE
  1368. if test 3707 -ne `wc -c <'LOME/MacroIO.c'`; then
  1369.     echo shar: \"'LOME/MacroIO.c'\" unpacked with wrong size!
  1370. fi
  1371. # end of 'LOME/MacroIO.c'
  1372. fi
  1373. if test -f 'LOME/MakeTail' -a "${1}" != "-c" ; then 
  1374.   echo shar: Will not clobber existing file \"'LOME/MakeTail'\"
  1375. else
  1376. echo shar: Extracting \"'LOME/MakeTail'\" \(3867 characters\)
  1377. sed "s/^X//" >'LOME/MakeTail' <<'END_OF_FILE'
  1378. X# Makefile for PPL LOME -- Line Oriented Macro Expander
  1379. X
  1380. X.c.o :
  1381. X    $(CC) $(CFLAGS) $*.c
  1382. X
  1383. X$(MACHINE) : LOME Comp1 Interp
  1384. X    date >$(MACHINE)
  1385. X
  1386. XLOME : LOME.o LOME0.o LOME1.o LOME2.o LOME3.o LOME4.o LOME5.o LOME6.o LOME7.o LOME8.o MacroIO.o
  1387. X    ld.$(MACHINE) LOME LOME.o LOME0.o LOME1.o LOME2.o LOME3.o LOME4.o LOME5.o LOME6.o LOME7.o LOME8.o MacroIO.o
  1388. X
  1389. XLOME.o    : LOME.c  LOME.h MacroIO.h $(INC)PPL.h
  1390. X
  1391. XLOME0.o : LOME0.c LOME.h MacroIO.h $(INC)PPL.h
  1392. X
  1393. XLOME1.o : LOME1.c LOME.h MacroIO.h $(INC)PPL.h
  1394. X
  1395. XLOME2.o : LOME2.c LOME.h MacroIO.h $(INC)PPL.h
  1396. X
  1397. XLOME3.o : LOME3.c LOME.h MacroIO.h $(INC)PPL.h
  1398. X
  1399. XLOME4.o : LOME4.c LOME.h MacroIO.h $(INC)PPL.h
  1400. X
  1401. XLOME5.o : LOME5.c LOME.h MacroIO.h $(INC)PPL.h
  1402. X
  1403. XLOME6.o : LOME6.c LOME.h MacroIO.h $(INC)PPL.h
  1404. X
  1405. XLOME7.o : LOME7.c LOME.h MacroIO.h $(INC)PPL.h
  1406. X
  1407. XLOME8.o : LOME8.c LOME.h MacroIO.h $(INC)PPL.h
  1408. X
  1409. XMacroIO.o : MacroIO.c MacroIO.h $(INC)PPL.h $(INC)TFS.h
  1410. X
  1411. XMIOtest : MIOtest.o MacroIO.o $(PPLLIB)
  1412. X    ld.$(MACHINE) MIOtest MIOtest.o MacroIO.o
  1413. X
  1414. XComp1 : Comp1.o MacroIO.o $(PPLLIB)
  1415. X    ld.$(MACHINE) Comp1 Comp1.o MacroIO.o
  1416. X
  1417. XComp1.o : Comp1.c $(INC)PPL.h MacroIO.h
  1418. X
  1419. XInterp : Interp.o Iparse.o Ifuncs1.o Ifuncs2.o Ifuncs3.o Ifuncs4.o MacroIO.o $(PPLLIB)
  1420. X    ld.$(MACHINE) Interp Interp.o Iparse.o Ifuncs1.o Ifuncs2.o Ifuncs3.o Ifuncs4.o MacroIO.o
  1421. X
  1422. XInterp.o : Interp.c Interp.h
  1423. X
  1424. XIparse.o : Iparse.c $(INC)PPL.h $(INC)TFS.h MacroIO.h Interp.h
  1425. X
  1426. XIfuncs1.o : Ifuncs1.c $(INC)PPL.h MacroIO.h Interp.h
  1427. X
  1428. XIfuncs2.o : Ifuncs2.c $(INC)PPL.h MacroIO.h Interp.h
  1429. X
  1430. XIfuncs3.o : Ifuncs3.c $(INC)PPL.h MacroIO.h Interp.h
  1431. X
  1432. XIfuncs4.o : Ifuncs4.c $(INC)PPL.h MacroIO.h Interp.h
  1433. X
  1434. XLOME.cat : LOME.doc
  1435. X    roff >LOME.cat -ub LOME.doc
  1436. X
  1437. X
  1438. Xtest : testMIO testLOME testCOMP1 testINTERP testRUBIN    # do regression tests
  1439. X
  1440. X#testMIO tests the basic MacroIO implementation
  1441. X
  1442. XtestMIO : MIOtest MIOtest1.inp
  1443. X    -$(DELETE) t:$(WILDCARD)
  1444. X    MIOtest MIOtest1.inp t:MIOtest2.out t:MIOtest3.out
  1445. X    $(DIFF) MIOtest2.out t:MIOtest2.out
  1446. X    $(DIFF) MIOtest3.out t:MIOtest3.out
  1447. X    $(DIFF) MIOtest8.out t:MIOTEST8.out
  1448. X
  1449. X#testLOME tests most aspects of LOME
  1450. X#This should print out one line on the console
  1451. X#t:LOME3.out and up should not exist
  1452. X
  1453. XtestLOME : LOME LOME.mac LOME.inp
  1454. X    -$(DELETE) t:$(WILDCARD)
  1455. X    LOME LOME.mac LOME.inp t:LOME1.out t:LOME2.out t:LOME3.out t:LOME4.out
  1456. X    $(DIFF) LOME1.out t:LOME1.out
  1457. X    $(DIFF) LOME2.out t:LOME2.out
  1458. X    $(DIFF) LOME9.out t:LOME9.out
  1459. X
  1460. X#This tests both the SCM.mac file and the Comp1 compiler
  1461. XtestCOMP1 : Comp1 SCM.mac SCMTestP.scm SCMTestD.inp
  1462. X    -$(DELETE) t:$(WILDCARD)
  1463. X    Comp1 SCM.mac SCMTestP.scm SCMTestP.c $(TTY)
  1464. X    $(DIFF) SCMTestC.out SCMTestP.c
  1465. X    $(CC) $(CFLAGS) SCMTestP.c
  1466. X    ld.$(MACHINE) SCMTestP SCMTestP.o MacroIO.o
  1467. X    -$(DELETE) t:SCMTestD.out
  1468. X    SCMTestP SCMTestD.inp t:SCMTestD.out $(TTY) $(TTY)
  1469. X    $(DIFF) SCMTestD.out t:SCMTestD.out
  1470. X    -$(DELETE) SCMTestP.c
  1471. X    -$(DELETE) SCMTestP.o
  1472. X    -$(DELETE) SCMTestP
  1473. X
  1474. X#This tests the interpreter
  1475. XtestINTERP : Interp SCMTestP.scm SCMTestD.inp
  1476. X    -$(DELETE) t:$(WILDCARD)
  1477. X    Interp SCMTestP.scm SCMTestD.inp t:SCMTestD.out
  1478. X    $(DIFF) SCMTestD.out t:SCMTestD.out
  1479. X
  1480. X#This exercises LOME some more by running more examples
  1481. XtestRUBIN : LOME Rubin.mac Rubin.inp Rubin.out
  1482. X    LOME Rubin.mac Rubin.inp t:Rubin.out $(TTY) $(TTY) $(TTY)
  1483. X    $(DIFF) Rubin.out t:Rubin.out
  1484. X
  1485. X
  1486. Xtags : LOME.c LOME.h LOME0.c LOME1.c LOME2.c LOME3.c LOME4.c
  1487. Xtags : LOME5.c LOME6.c LOME7.c LOME8.c MacroIO.h MacroIO.c
  1488. X    ctags LOME.c LOME.h LOME0.c LOME1.c LOME2.c LOME3.c LOME4.c
  1489. X    ctags -a LOME5.c LOME6.c LOME7.c LOME8.c MacroIO.h MacroIO.c
  1490. X
  1491. X
  1492. Xzap : clean
  1493. X    -$(DELETE) $(MACHINE)
  1494. X    -$(DELETE) LOME
  1495. X    -$(DELETE) Comp1
  1496. X    -$(DELETE) Interp
  1497. X    -$(DELETE) MIOtest
  1498. X    -$(DELETE) tags
  1499. X
  1500. Xclean :
  1501. X    -$(DELETE) $(WILDCARD).tmp
  1502. X    -$(DELETE) $(WILDCARD).o
  1503. X    -$(DELETE) $(WILDCARD).lnk
  1504. X    -$(DELETE) t:$(WILDCARD)
  1505. X    -$(DELETE) $(WILDCARD).err
  1506. X    -$(DELETE) core             #UNIX crash dump
  1507. X    -$(DELETE) SnapShot.TB      #Amiga LC crash dump
  1508. X    -$(DELETE) SCMTestP.c
  1509. X    -$(DELETE) SCMTestP.o
  1510. X    -$(DELETE) SCMTestP
  1511. X
  1512. X#end of Makefile
  1513. X
  1514. X
  1515. END_OF_FILE
  1516. if test 3867 -ne `wc -c <'LOME/MakeTail'`; then
  1517.     echo shar: \"'LOME/MakeTail'\" unpacked with wrong size!
  1518. fi
  1519. # end of 'LOME/MakeTail'
  1520. fi
  1521. if test -f 'LOME/Rubin.out' -a "${1}" != "-c" ; then 
  1522.   echo shar: Will not clobber existing file \"'LOME/Rubin.out'\"
  1523. else
  1524. echo shar: Extracting \"'LOME/Rubin.out'\" \(2569 characters\)
  1525. sed "s/^X//" >'LOME/Rubin.out' <<'END_OF_FILE'
  1526. XFILE: Rubin&.inp
  1527. XThis is a test file for Rubin
  1528. XIt really doesn't do anything except test a few options
  1529. XThis is by no means an exhaustive test
  1530. X
  1531. XThis should come out unchanged
  1532. Xbecause it does not start with an asterisk
  1533. X
  1534. XTest simple cases:
  1535. XC      gamma = alpha + beta
  1536. X       CALLQ8 ADD(0,0,gamma,0,alpha,0,beta,0)
  1537. XC      gamma = alpha - beta
  1538. X       CALLQ8 SUB(0,0,gamma,0,alpha,0,beta,0)
  1539. XC      gamma = alpha * beta
  1540. X       CALLQ8 MULT(0,0,gamma,0,alpha,0,beta,0)
  1541. XC      gamma = alpha / beta
  1542. X       CALLQ8 DIV(0,0,gamma,0,alpha,0,beta,0)
  1543. X
  1544. XTest simple cases with modifiers:
  1545. XC      gamma = alpha +x beta
  1546. X       CALLQ8 ADDx(0,0,gamma,0,alpha,0,beta,0)
  1547. XC      gamma = alpha -h beta
  1548. X       CALLQ8 SUBh(0,0,gamma,0,alpha,0,beta,0)
  1549. XC      gamma = alpha *f beta
  1550. X       CALLQ8 MULTf(0,0,gamma,0,alpha,0,beta,0)
  1551. XC      gamma = alpha /u beta
  1552. X       CALLQ8 DIVu(0,0,gamma,0,alpha,0,beta,0)
  1553. X
  1554. XTest negations
  1555. XC      gamma = -alpha + beta
  1556. X       CALLQ8 ADD(2,0,gamma,0,alpha,0,beta,0)
  1557. X
  1558. XTest absolute values
  1559. XC      gamma = |alpha - beta
  1560. X       CALLQ8 SUB(4,0,gamma,0,alpha,0,beta,0)
  1561. XC      gamma = |alpha - |beta
  1562. X       CALLQ8 SUB(5,0,gamma,0,alpha,0,beta,0)
  1563. XC      gamma = alpha - |beta
  1564. X       CALLQ8 SUB(1,0,gamma,0,alpha,0,beta,0)
  1565. XC      gamma = -|alpha - |beta
  1566. X       CALLQ8 SUB(7,0,gamma,0,alpha,0,beta,0)
  1567. X
  1568. XTest a w field
  1569. XC      gamma = alpha + beta /\omega
  1570. X       CALLQ8 ADD(0,0,gamma,0,alpha,omega,beta,0)
  1571. XC      gamma = alpha + beta /\~omega
  1572. X       CALLQ8 ADD(64,0,gamma,0,alpha,omega,beta,0)
  1573. X
  1574. XTry the type casts
  1575. XC      gamma =(half) alpha + beta
  1576. X       CALLQ8 ADD(128,0,gamma,0,alpha,0,beta ,0)
  1577. XC      gamma =(full) alpha + beta
  1578. X       CALLQ8 ADD(0,0,gamma,0,alpha,0,beta ,0)
  1579. XC      gamma = (scalar)alpha + beta
  1580. X       CALLQ8 ADD(16,0,gamma,0,alpha,0,beta,0)
  1581. XC      gamma = alpha + (scalar)beta
  1582. X       CALLQ8 ADD(8,0,gamma,0,alpha,0,beta,0)
  1583. XC      gamma = (scalar)alpha + (scalar)beta
  1584. X       CALLQ8 ADD(24,0,gamma,0,alpha,0,beta,0)
  1585. XC      gamma =(half) (scalar)alpha + (scalar)beta
  1586. X       CALLQ8 ADD(152,0,gamma,0,alpha,0,beta ,0)
  1587. X
  1588. XTry x, y, and z
  1589. XC      gamma'gift = alpha + beta
  1590. X       CALLQ8 ADD(32,0,gamma,0,alpha,0,beta,gift)
  1591. XC      gamma = alpha'apple + beta
  1592. X       CALLQ8 ADD(0,apple,gamma,0,alpha,0,beta,0)
  1593. XC      gamma = alpha + beta'book
  1594. X       CALLQ8 ADD(0,0,gamma,book,alpha,0,beta,0)
  1595. XC      gamma'gift = alpha'apple + beta'book
  1596. X       CALLQ8 ADD(32,apple,gamma,book,alpha,0,beta,gift)
  1597. X
  1598. XTry a line with everything on it
  1599. XC      gamma'gift =(half) -|(scalar)alpha'apple *big |(scalar)beta'book /\~omega
  1600. X       CALLQ8 MULTbig(255,apple,gamma,book,alpha,omega,beta ,gift)
  1601. X
  1602. END_OF_FILE
  1603. if test 2569 -ne `wc -c <'LOME/Rubin.out'`; then
  1604.     echo shar: \"'LOME/Rubin.out'\" unpacked with wrong size!
  1605. fi
  1606. # end of 'LOME/Rubin.out'
  1607. fi
  1608. if test -f 'LOME/SCMTestD.inp' -a "${1}" != "-c" ; then 
  1609.   echo shar: Will not clobber existing file \"'LOME/SCMTestD.inp'\"
  1610. else
  1611. echo shar: Extracting \"'LOME/SCMTestD.inp'\" \(3137 characters\)
  1612. sed "s/^X//" >'LOME/SCMTestD.inp' <<'END_OF_FILE'
  1613. X1. IF SCM MACROS ARE CORRECT, OUTPUT CONTAINS NO LINES STARTING WITH X
  1614. X2. Lines starting with X indicate errors in macros or I/O.
  1615. X3. First three lines rely on VAL B = 1 + 0, VAL W = 2 + 0, GET BUFF B, PUT BUFF W.
  1616. X4. If this works, CALL F seems to work.
  1617. XX 001    TO $$ did not skip
  1618. XX 002    TO $$ IF FLG $ EQ $ fails on equal
  1619. XX 003    TO $$ IF FLG $ EQ $ skips on unequal
  1620. XX 004    TO $$ IF FLG $ NE $ skips on equal
  1621. XX 005    TO $$ IF FLG $ NE $ fails on unequal
  1622. XX 006    TO $$ IF VAL $ EQ $ fails on equal
  1623. XX 007    TO $$ IF VAL $ EQ $ skips on unequal
  1624. XX 008    TO $$ IF VAL $ NE $ skips on equal
  1625. XX 009    TO $$ IF VAL $ NE $ fails on unequal
  1626. XX 010    TO $$ IF PTR $ EQ $ fails on equal
  1627. XX 011    TO $$ IF PTR $ EQ $ skips on unequal
  1628. XX 012    TO $$ IF PTR $ NE $ skips on equal
  1629. XX 013    TO $$ IF PTR $ NE $ fails on unequal
  1630. XX 014    TO $$ IF PTR $ LT $ fails on less than
  1631. XX 015    TO $$ IF PTR $ LT $ skips on greater than
  1632. XX 016    TO $$ IF PTR $ LT $ skips on equal
  1633. XX 017    FLG $ = $ did not change destination
  1634. XX 018    VAL $ = PTR $ did not change destination
  1635. XX 019    PTR $ = VAL $ did not change destination
  1636. XX 020    PTR $ = VAL $ changes FLG field
  1637. XX 021    PTR $ = VAL $ changes VAL field
  1638. XX 022    VAL $ = PTR $ changes FLG field
  1639. XX 023    VAL $ = PTR $ changes PTR field
  1640. XX 024    FLG $ = $ changes VAL field
  1641. XX 025    VAL $ = $ changes PTR field
  1642. XX 026    VAL $ = $ + $ fails for (1 + 2)
  1643. XX 027    VAL $ = $ + $ changes PTR for (1 + 2)
  1644. XX 028    VAL $ = $ + $ changes FLG for (1 + 2)
  1645. X5. Next line contains "6. GOOD" - anything else is wrong
  1646. X6. DOG
  1647. XX 029    VAL $ = INPUT did not find end-of-line in right place
  1648. X7. Next line contains "8. 0 1 2 3 4 5 6 7 8 9" from VAL fields
  1649. X8. 0
  1650. XX 030    VAL $ = INPUT did not find end-of-line in right place
  1651. X9. Next line contains "10. 0 1 2 3" from PTR fields
  1652. X10. 0
  1653. XX 031    VAL $ = INPUT did not find end-of-line in right place
  1654. XX 032    PTR $ = $ + $ changes FLG field (1 + 2)
  1655. XX 033    PTR $ = $ + $ changes VAL field (1 + 2)
  1656. XX 034    PTR $ = $ + $ fails (for 1 + 2)
  1657. XX 035    PTR $ = $ - $ changes FLG field (1 - 3)
  1658. XX 036    PTR $ = $ - $ changes VAL field (1 - 3)
  1659. XX 037    PTR $ = $ - $ fails (1 - 3)
  1660. XX 038    VAL $ = $ - $ changes FLG field (1 - 3)
  1661. XX 039    VAL $ = $ - $ changes PTR field (1 - 3)
  1662. XX 040    VAL $ = $ - $ fails (1 - 3)
  1663. XX 041    PTR $ = $ * $ fails (1 * 3)
  1664. XX 042    PTR $ = $ * $ changes VAL field (3 * 3)
  1665. XX 043    PTR $ = $ * $ changes FLG field (3 * 3)
  1666. XX 044    PTR $ = $ / $ fails (6 / 2)
  1667. XX 045    PTR $ = $ / $ changes VAL field (6 / 2)
  1668. XX 046    PTR $ = $ / $ changes FLG field (6 / 2)
  1669. XX 047    PTR $ = $ / $ does not return 3 = 7 / 2
  1670. XX 048    PTR $ = $ / $ does not return (-3) = (-7) / 2
  1671. XX 049    PTR $ = $ / $ does not return (-3) = 7 / (-2)
  1672. XX 050    PTR $ = $ / $ does not return 3 = (-7) / (-2)
  1673. XX 051    PTR $ = $ * $ does not return (-4) = 2 * (-2)
  1674. XX 052    PTR $ = $ * $ does not return (-4) = (-2) * 2
  1675. XX 053    PTR $ = $ * $ does not return 4 = (-2) * (-2)
  1676. XX 054    TO $$ IF VAL $ EQ $ skips on (-6, +6)
  1677. XX 055    TO $$ IF VAL $ NE $ fails on (-6, +6)
  1678. XX 056    TO $$ IF PTR $ EQ $ skips on (-3, +3)
  1679. XX 057    TO $$ IF PTR $ NE $ fails on (-3, +3)
  1680. XX 058    TO $$ IF PTR $ LT $ fails on (-3, +3)
  1681. XX 059    TO $$ IF PTR $ LT $ skips on (+3, -3)
  1682. X99. This should be printed as the last line. - END OF TEST ONE
  1683. XX IF THIS PRINTS, DATA OR PROGRAM IS INCORRECT!
  1684. X
  1685. END_OF_FILE
  1686. if test 3137 -ne `wc -c <'LOME/SCMTestD.inp'`; then
  1687.     echo shar: \"'LOME/SCMTestD.inp'\" unpacked with wrong size!
  1688. fi
  1689. # end of 'LOME/SCMTestD.inp'
  1690. fi
  1691. if test -f 'PPL/FaultAmiga.c' -a "${1}" != "-c" ; then 
  1692.   echo shar: Will not clobber existing file \"'PPL/FaultAmiga.c'\"
  1693. else
  1694. echo shar: Extracting \"'PPL/FaultAmiga.c'\" \(2248 characters\)
  1695. sed "s/^X//" >'PPL/FaultAmiga.c' <<'END_OF_FILE'
  1696. X/*
  1697. X    FaultAmiga.c
  1698. X    This is the code for AssertBomb.
  1699. X*/
  1700. X
  1701. X#include "proto/exec.h"
  1702. X#include "proto/intuition.h"
  1703. X#include "proto/dos.h"
  1704. X
  1705. Xint AssertBomb(char *, char *, int, int, int (*)());
  1706. X
  1707. Xint AssertBomb(s, file, line, z, exitfunc)
  1708. Xchar * s;    /* text of assertion */
  1709. Xchar * file;    /* file that AssertBomb call appeared in */
  1710. Xint    line;    /* line at which alertbomb appeared */
  1711. Xint    z;    /* special string flag */
  1712. Xint  (*exitfunc)(void);     /* call this if assert fails */
  1713. X{
  1714. X#define c(x) *i++ = (x)
  1715. X    register int result = 0;
  1716. X    register char * j;
  1717. X    char dispmess[500];
  1718. X    register char * i;
  1719. X    int flag = 0;
  1720. X
  1721. X    i = dispmess;
  1722. X    if (IntuitionBase == 0) {
  1723. X    flag = 1;
  1724. X    IntuitionBase = (struct IntuitionBase *)
  1725. X        OpenLibrary("intuition.library", 0);
  1726. X    }
  1727. X
  1728. X    /* display s at upper left */
  1729. X    c(0); c(15); c(15);
  1730. X    if ((z & 7) == 1) {
  1731. X    j = "Assert: ";
  1732. X    while (*j) c(*j++);
  1733. X    }
  1734. X    else if ((z & 7) == 2) {
  1735. X    j = "Fault: ";
  1736. X    while (*j) c(*j++);
  1737. X    }
  1738. X    else if ((z & 7) == 3) {
  1739. X    j = "Bomb: ";
  1740. X    while (*j) c(*j++);
  1741. X    }
  1742. X    j = s;
  1743. X    while (*j) c(*j++);
  1744. X    c(0); c(1);
  1745. X
  1746. X    /* file, then line on line two */
  1747. X    c(0); c(15); c(30);
  1748. X    j = file;
  1749. X    while (*j) c(*j++);
  1750. X    c(' '); c(' ');
  1751. X    c('0' + (line / 10000 % 10));
  1752. X    c('0' + (line /  1000 % 10));
  1753. X    c('0' + (line /   100 % 10));
  1754. X    c('0' + (line /    10 % 10));
  1755. X    c('0' + (line /     1 % 10));
  1756. X    c(0); c(1);
  1757. X
  1758. X    /* left / right messages */
  1759. X    if (0 == (z & 0x80)) {
  1760. X    c(0); c(20); c(45);
  1761. X    j = "Left mouse to retry after pause.";
  1762. X    while (*j) c(*j++);
  1763. X    c(0); c(1);
  1764. X    }
  1765. X    c(450 / 256); c(450 % 256); c(45);
  1766. X    j = "Right mouse to abort.";
  1767. X    while (*j) c(*j++);
  1768. X    c(0); c(0);
  1769. X
  1770. X    result = DisplayAlert(0, dispmess, 55);
  1771. X
  1772. X    if (flag) {
  1773. X    CloseLibrary((struct Library *) IntuitionBase);
  1774. X    IntuitionBase = 0;
  1775. X    }
  1776. X
  1777. X    if (result == 0 && 0 != (z & 0x80)) {
  1778. X    (*exitfunc)();
  1779. X    }
  1780. X
  1781. X    /* Here, if the user requests to retry, we delay for fifteen
  1782. X       seconds to allow the user to close other apps, change disks,
  1783. X       or whatever it takes to make this succeed. This is needed
  1784. X       because DisplayAlert() disables the multitasking. */
  1785. X
  1786. X    if (result && 0 == (z & 0x80))
  1787. X    Delay((unsigned long) 50 * 15);
  1788. X    else if (result)
  1789. X    Delay((unsigned long) 50);
  1790. X
  1791. X    return result;
  1792. X    }
  1793. X
  1794. END_OF_FILE
  1795. if test 2248 -ne `wc -c <'PPL/FaultAmiga.c'`; then
  1796.     echo shar: \"'PPL/FaultAmiga.c'\" unpacked with wrong size!
  1797. fi
  1798. # end of 'PPL/FaultAmiga.c'
  1799. fi
  1800. if test -f 'PPL/FaultUnix.c' -a "${1}" != "-c" ; then 
  1801.   echo shar: Will not clobber existing file \"'PPL/FaultUnix.c'\"
  1802. else
  1803. echo shar: Extracting \"'PPL/FaultUnix.c'\" \(2149 characters\)
  1804. sed "s/^X//" >'PPL/FaultUnix.c' <<'END_OF_FILE'
  1805. X/*
  1806. X    FaultUnix.c
  1807. X    This is the code for AssertBomb.
  1808. X*/
  1809. X
  1810. X#include <stdio.h>
  1811. Xextern int open(char *, int);
  1812. Xextern int read(int, char *, int);
  1813. Xextern int write(int, char *, int);
  1814. Xextern int close(int);
  1815. Xextern void fflush(FILE *);
  1816. Xextern int strlen(char *);
  1817. Xextern int isatty(int);
  1818. X
  1819. Xint AssertBomb(char *, char *, int, int, int (*)(void));
  1820. X
  1821. Xint AssertBomb(s, file, line, z, exitfunc)
  1822. Xchar * s;    /* text of assertion */
  1823. Xchar * file;    /* file that AssertBomb call appeared in */
  1824. Xint    line;    /* line at which alertbomb appeared */
  1825. Xint    z;    /* special string flag */
  1826. Xint  (*exitfunc)(void);     /* call this if assert fails */
  1827. X{
  1828. X#define c(x) *i++ = (x)
  1829. X    register int result = 1;
  1830. X    register char * j;
  1831. X    char dispmess[500];
  1832. X    register char * i;
  1833. X    char flag = 0;
  1834. X    int fh;
  1835. X
  1836. X    i = dispmess;
  1837. X    fh = open("/dev/tty", 2);       /* open console R/W */
  1838. X
  1839. X    /* display s at upper left */
  1840. X    c('\r'); c('\n');
  1841. X    if ((z & 7) == 1) {
  1842. X    j = "Assert: ";
  1843. X    while (*j) c(*j++);
  1844. X    }
  1845. X    else if ((z & 7) == 2) {
  1846. X    j = "Fault: ";
  1847. X    while (*j) c(*j++);
  1848. X    }
  1849. X    else if ((z & 7) == 3) {
  1850. X    j = "Bomb: ";
  1851. X    while (*j) c(*j++);
  1852. X    }
  1853. X    j = s;
  1854. X    while (*j) c(*j++);
  1855. X    c('\r'); c('\n');
  1856. X
  1857. X    /* file, then line on line two */
  1858. X    j = file;
  1859. X    while (*j) c(*j++);
  1860. X    c(' '); c(' ');
  1861. X    c('0' + (line / 10000 % 10));
  1862. X    c('0' + (line /  1000 % 10));
  1863. X    c('0' + (line /   100 % 10));
  1864. X    c('0' + (line /    10 % 10));
  1865. X    c('0' + (line /     1 % 10));
  1866. X    c('\r'); c('\n');
  1867. X
  1868. X    /* left / right messages */
  1869. X    if (0 == (z & 0x80)) {
  1870. X    j = "R to retry.        ";
  1871. X    while (*j) c(*j++);
  1872. X    }
  1873. X    j = "A to abort.";
  1874. X    while (*j) c(*j++);
  1875. X    c('\r'); c('\n'); c('\0');
  1876. X
  1877. X    if (fh != -1 && isatty(fh)) {
  1878. X    int i;    /* don't try to read anymore on EOF or error */
  1879. X    fflush(stdout); fflush(stderr); fflush(stdin);
  1880. X    (void) write(fh, dispmess, strlen(dispmess));
  1881. X    if (1 != (i = read(fh, &flag, 1)) || (flag != 'R' && flag != 'r'))
  1882. X        result = 0;
  1883. X    else
  1884. X        result = 1;
  1885. X    while (flag != '\n' && 1 == i && 1 == read(fh, &flag, 1))
  1886. X        /* toss the rest of the line */ ;
  1887. X    (void) close(fh);
  1888. X    }
  1889. X
  1890. X    if (result == 0 && 0 != (z & 0x80)) {
  1891. X    (*exitfunc)();
  1892. X    }
  1893. X
  1894. X    return result;
  1895. X    }
  1896. X
  1897. END_OF_FILE
  1898. if test 2149 -ne `wc -c <'PPL/FaultUnix.c'`; then
  1899.     echo shar: \"'PPL/FaultUnix.c'\" unpacked with wrong size!
  1900. fi
  1901. # end of 'PPL/FaultUnix.c'
  1902. fi
  1903. if test -f 'TFS/TFS.doc' -a "${1}" != "-c" ; then 
  1904.   echo shar: Will not clobber existing file \"'TFS/TFS.doc'\"
  1905. else
  1906. echo shar: Extracting \"'TFS/TFS.doc'\" \(2767 characters\)
  1907. sed "s/^X//" >'TFS/TFS.doc' <<'END_OF_FILE'
  1908. X.rm 75
  1909. X.rm 70
  1910. X.po 2
  1911. X.he 'TFS.Doc'Text File Subsystem'Darren New'
  1912. X.fo '    Page #' 'Printed %    '
  1913. X.pl 63
  1914. X.nj
  1915. X.ce 4
  1916. XThis documentation and all accompanying files
  1917. XCopyright 1988 Darren New.
  1918. XAll Rights Reserved.
  1919. XSee README for distribution conditions.
  1920. X
  1921. XThis file documents the proposed "Text File Subsystem"
  1922. X(hereinafter referred to as "TFS"),
  1923. Xa subsystem of the "Portable Programmer's Library".
  1924. X
  1925. X
  1926. XThe TFS allows for the manipulation of line-oriented text files. It is not
  1927. Xpossible with the TFS to manipulate only parts of lines; only full lines
  1928. Xmay be written or read. In addition, it is not possible to update the
  1929. Xmiddle of a TFS file; a given file is opened either for read or write, not
  1930. Xboth. While reading, it may be possible to seek to other lines within the
  1931. Xfile; this depends on the host. Note that all of these routines are
  1932. Ximplemented for each host; there are no high-level routines here.
  1933. X
  1934. X.fi
  1935. X.ce
  1936. X***************************************************************
  1937. X
  1938. XThe TFS supports the following functions, as described more fully in the
  1939. XTFS.h header file.
  1940. X
  1941. XTFSInit()       - Called to allow host to initialize anything it needs.
  1942. X
  1943. XTFSOpen()       - Open a text file. Arguments include the open mode and the
  1944. Xhost-syntax file name to be opened. Return is a TFSfile "handle". This
  1945. Xhandle is in an internal format that the application cannot access. The
  1946. Xhandle returned is a LONG, but it may just be an index into a table or it
  1947. Xmay be cast from a pointer. In any case, a return of zero means an error
  1948. Xhas ocurred. If the file is opened for reading, other processes may be able
  1949. Xto read the file at the same time. If any process opens the file for
  1950. Xwriting, only that process may access that file until it is closed. A file
  1951. Xmust be opened before ANY other operation may be applied, including TFSInfo
  1952. Xand TFSDestroy.
  1953. X
  1954. XTFSClose()      - Close a text file. This breaks a connection between a
  1955. Xhandle and a file, possibly after flushing buffers. After this, other
  1956. Xprocesses or programs may access the file.
  1957. X
  1958. XTFSInfo()       - Determine file parameters. This may return various
  1959. Xparameters about the given file. The description of the information
  1960. Xreturned is given in the TFS.h file.
  1961. X
  1962. XTFSRead()       - Read a line. Only entire lines are read. A '\0' is
  1963. Xappened to the buffer. Lines longer than BIGLINE get truncated with an
  1964. Xerror return.
  1965. X
  1966. XTFSWrite()      - Write a line. The buffer must end in a '\0' and must be
  1967. Xshorter that BIGLINE.
  1968. X
  1969. XTFSNote()       - Remember from where in the file the next line will be
  1970. Xread.
  1971. X
  1972. XTFSPoint()      - Return file to where is was when TFSNote() was called.
  1973. X
  1974. XTFSDestroy()    - Free space occupied by a text file. This may return an
  1975. Xerror if another process has the file open.
  1976. X
  1977. XTFSTerm()       - Allows host to deinitialize anything it needs.
  1978. X
  1979. X
  1980. X
  1981. END_OF_FILE
  1982. if test 2767 -ne `wc -c <'TFS/TFS.doc'`; then
  1983.     echo shar: \"'TFS/TFS.doc'\" unpacked with wrong size!
  1984. fi
  1985. # end of 'TFS/TFS.doc'
  1986. fi
  1987. if test -f 'TFS/TestTFS.inp' -a "${1}" != "-c" ; then 
  1988.   echo shar: Will not clobber existing file \"'TFS/TestTFS.inp'\"
  1989. else
  1990. echo shar: Extracting \"'TFS/TestTFS.inp'\" \(2291 characters\)
  1991. sed "s/^X//" >'TFS/TestTFS.inp' <<'END_OF_FILE'
  1992. XTest Line One
  1993. XThis is Two
  1994. X
  1995. XThis, too, should appear.
  1996. X
  1997. XThis has trailing spaces   
  1998. XThis has trailing tabs and spaces           
  1999. X    This has a leading tab.
  2000. X        This has eight leading spaces
  2001. XThis has exactly one trailing tab    
  2002. XThis has exactly one trailing space 
  2003. X
  2004. X01234567890123456789012345678901234567890123456
  2005. X012345678901234567890123456789012345678901234567
  2006. X0123456789012345678901234567890123456789012345678
  2007. X01234567890123456789012345678901234567890123456789
  2008. X012345678901234567890123456789012345678901234567890
  2009. X
  2010. Xa123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
  2011. Xb1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567
  2012. Xc12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
  2013. Xd123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
  2014. Xe1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
  2015. Xf12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901
  2016. Xg123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012
  2017. X
  2018. XThis is the last line---
  2019. END_OF_FILE
  2020. if test 2291 -ne `wc -c <'TFS/TestTFS.inp'`; then
  2021.     echo shar: \"'TFS/TestTFS.inp'\" unpacked with wrong size!
  2022. fi
  2023. # end of 'TFS/TestTFS.inp'
  2024. fi
  2025. if test -f 'TFS/TestTFS2.out' -a "${1}" != "-c" ; then 
  2026.   echo shar: Will not clobber existing file \"'TFS/TestTFS2.out'\"
  2027. else
  2028. echo shar: Extracting \"'TFS/TestTFS2.out'\" \(2290 characters\)
  2029. sed "s/^X//" >'TFS/TestTFS2.out' <<'END_OF_FILE'
  2030. XTest Line One
  2031. XThis is Two
  2032. X
  2033. XThis, too, should appear.
  2034. X
  2035. XThis has trailing spaces
  2036. XThis has trailing tabs and spaces
  2037. X    This has a leading tab.
  2038. X        This has eight leading spaces
  2039. XThis has exactly one trailing tab
  2040. XThis has exactly one trailing space
  2041. X
  2042. X01234567890123456789012345678901234567890123456
  2043. X012345678901234567890123456789012345678901234567
  2044. X0123456789012345678901234567890123456789012345678
  2045. X01234567890123456789012345678901234567890123456789
  2046. X012345678901234567890123456789012345678901234567890
  2047. X
  2048. Xa123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
  2049. Xb1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567
  2050. Xc12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
  2051. Xd12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
  2052. Xe12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
  2053. Xf12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
  2054. Xg12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
  2055. X
  2056. XThis is the last line---
  2057. X3 Trailing spaces:
  2058. END_OF_FILE
  2059. if test 2290 -ne `wc -c <'TFS/TestTFS2.out'`; then
  2060.     echo shar: \"'TFS/TestTFS2.out'\" unpacked with wrong size!
  2061. fi
  2062. # end of 'TFS/TestTFS2.out'
  2063. fi
  2064. echo shar: End of archive 2 \(of 9\).
  2065. cp /dev/null ark2isdone
  2066. MISSING=""
  2067. for I in 1 2 3 4 5 6 7 8 9 ; do
  2068.     if test ! -f ark${I}isdone ; then
  2069.     MISSING="${MISSING} ${I}"
  2070.     fi
  2071. done
  2072. if test "${MISSING}" = "" ; then
  2073.     echo You have unpacked all 9 archives.
  2074.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  2075. else
  2076.     echo You still need to unpack the following archives:
  2077.     echo "        " ${MISSING}
  2078. fi
  2079. ##  End of shell archive.
  2080. exit 0
  2081. -- 
  2082. --- Darren New --- Grad Student --- CIS --- Univ. of Delaware ---
  2083.  
  2084. exit 0 # Just in case...
  2085. -- 
  2086. Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.
  2087. Use a domain-based address or give alternate paths, or you may lose out.
  2088.